{-# LANGUAGE TypeOperators              #-}
{-# OPTIONS -Wall #-}

--------------------------------------------------------------------------------
-- |
-- Module      :  Ochre.Language.GensBase
-- Copyright   :  (c) Stephen Tetley 2013
-- License     :  BSD3
--
-- Maintainer  :  stephen.tetley@gmail.com
-- Stability   :  unstable
-- Portability :  GHC
--
-- Orchestra gentables - bindable to variables via @ftgen@.
-- 
--------------------------------------------------------------------------------

module Ochre.Language.GensBase
  (

    Signum(..)
  , tableSign
  , Gen
  , ftgen

  , makeGen
  , makeGenP 

  , isPow2
  , isPow2Succ

  ) where

import Ochre.Compiler.Syntax hiding ( Unit )

import Ochre.Compiler.VarId
import Ochre.Language.Prim


data Signum = PVE | NVE
  deriving (Eq,Show)

tableSign :: Signum -> Int -> Int
tableSign PVE i = abs i
tableSign NVE i = negate $ abs i 

-- Score code
-- > tables :: ScoreCode ()
-- > tables = gentable 1 0 1024 $ gen10 [1.0]

-- Becomes Orch code:
-- giSine <- ftgen IRate 1 0 1024 $ gen10 [1.0] 


-- | Gen is a function:
--
-- > activation-time * size -> [Values]
--
-- CsDoc allows errors which are needed for table size errors.
-- Also we use a genuine Int (not an IInt) for table size so 
-- we can catch these errors.
--  
newtype Gen = Gen { _getGen :: IFloat -> Int -> Either ErrMsg [Value] } 


-- Implementation note - always use 0 for first argument (ifn) 
-- in the genrated code then Csound automatically generates table 
-- indices.
--
ftgen :: IKA_Signal rate 
      => (String ::: rate) -> IFloat -> Int ->  Gen -> Orch TableIx
ftgen (ss ::: rid) act_time sz (Gen f) = 
    case f act_time sz of
      Left err -> throwErr err
      Right xs -> globalAssignTable ss (rateId rid) 
                                       (PrimId "ftgen") (Int 0 : xs) 



tablestmt :: IFloat -> Int -> Int -> [Value] -> [Value]
tablestmt act_time sz gen_num vals = 
    let front = [ getPValue act_time, Int sz, Int gen_num ]
    in front ++ vals

makeGen :: Int -> [Value] -> Gen 
makeGen gen_num vals = Gen $ \act_time sz -> 
    Right $ tablestmt act_time sz gen_num vals
    


makeGenP :: Int -> (Int -> Bool) -> String -> [Value] -> Gen
makeGenP gen_num test err_msg vals = Gen $ \act_time sz ->
    if test sz then Right $ tablestmt act_time sz gen_num vals
               else Left err_msg




isPow2 :: Int -> Bool
isPow2 i = i `within` [ (2^x) | x <- [(1::Int) ..] ]
  where
    within x (y:ys) | x < y     = False
                    | x == y    = True  
                    | otherwise = within x ys
    within _ []                 = error "unreachable - within"


isPow2Succ :: Int -> Bool
isPow2Succ i = i `within` [ (2^x) | x <- [(1::Int) ..] ]
  where
    within x (y:ys) | x < y     = False
                    | x == y    = True  
                    | x-1 == y  = True
                    | otherwise = within x ys
    within _ []                 = error "unreachable - within"